home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / datech1r / frmabout.frm (.txt) < prev    next >
Visual Basic Form  |  1999-08-02  |  10KB  |  234 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "About Black Jack"
  5.    ClientHeight    =   3555
  6.    ClientLeft      =   2340
  7.    ClientTop       =   1935
  8.    ClientWidth     =   5730
  9.    ClipControls    =   0   'False
  10.    LinkTopic       =   "Form2"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   2453.724
  14.    ScaleMode       =   0  'User
  15.    ScaleWidth      =   5380.766
  16.    ShowInTaskbar   =   0   'False
  17.    Begin VB.PictureBox picIcon 
  18.       AutoSize        =   -1  'True
  19.       BorderStyle     =   0  'None
  20.       ClipControls    =   0   'False
  21.       Height          =   480
  22.       Left            =   240
  23.       Picture         =   "frmAboutbj.frx":0000
  24.       ScaleHeight     =   337.12
  25.       ScaleMode       =   0  'User
  26.       ScaleWidth      =   337.12
  27.       TabIndex        =   1
  28.       Top             =   240
  29.       Width           =   480
  30.    End
  31.    Begin VB.CommandButton cmdOK 
  32.       Cancel          =   -1  'True
  33.       Caption         =   "OK"
  34.       Default         =   -1  'True
  35.       Height          =   345
  36.       Left            =   4245
  37.       TabIndex        =   0
  38.       Top             =   2625
  39.       Width           =   1260
  40.    End
  41.    Begin VB.CommandButton cmdSysInfo 
  42.       Caption         =   "&System Info..."
  43.       Height          =   345
  44.       Left            =   4260
  45.       TabIndex        =   2
  46.       Top             =   3075
  47.       Width           =   1245
  48.    End
  49.    Begin VB.Line Line1 
  50.       BorderColor     =   &H00808080&
  51.       BorderStyle     =   6  'Inside Solid
  52.       Index           =   1
  53.       X1              =   84.515
  54.       X2              =   5309.398
  55.       Y1              =   1687.583
  56.       Y2              =   1687.583
  57.    End
  58.    Begin VB.Label lblDescription 
  59.       Caption         =   "By John Shannon            notoffensivetoanyone@yahoo.com"
  60.       ForeColor       =   &H00000000&
  61.       Height          =   1170
  62.       Left            =   2370
  63.       TabIndex        =   3
  64.       Top             =   1125
  65.       Width           =   2565
  66.    End
  67.    Begin VB.Label lblTitle 
  68.       Caption         =   "Black Jack"
  69.       BeginProperty Font 
  70.          Name            =   "Comic Sans MS"
  71.          Size            =   14.25
  72.          Charset         =   0
  73.          Weight          =   400
  74.          Underline       =   0   'False
  75.          Italic          =   0   'False
  76.          Strikethrough   =   0   'False
  77.       EndProperty
  78.       ForeColor       =   &H00000000&
  79.       Height          =   480
  80.       Left            =   2370
  81.       TabIndex        =   5
  82.       Top             =   240
  83.       Width           =   2565
  84.    End
  85.    Begin VB.Line Line1 
  86.       BorderColor     =   &H00FFFFFF&
  87.       BorderWidth     =   2
  88.       Index           =   0
  89.       X1              =   98.6
  90.       X2              =   5309.398
  91.       Y1              =   1697.936
  92.       Y2              =   1697.936
  93.    End
  94.    Begin VB.Label lblVersion 
  95.       Caption         =   "Version 1.0 "
  96.       BeginProperty Font 
  97.          Name            =   "Comic Sans MS"
  98.          Size            =   8.25
  99.          Charset         =   0
  100.          Weight          =   400
  101.          Underline       =   0   'False
  102.          Italic          =   0   'False
  103.          Strikethrough   =   0   'False
  104.       EndProperty
  105.       Height          =   225
  106.       Left            =   2370
  107.       TabIndex        =   6
  108.       Top             =   780
  109.       Width           =   2565
  110.    End
  111.    Begin VB.Label lblDisclaimer 
  112.       ForeColor       =   &H00000000&
  113.       Height          =   825
  114.       Left            =   255
  115.       TabIndex        =   4
  116.       Top             =   2625
  117.       Width           =   3870
  118.    End
  119. Attribute VB_Name = "frmAbout"
  120. Attribute VB_GlobalNameSpace = False
  121. Attribute VB_Creatable = False
  122. Attribute VB_PredeclaredId = True
  123. Attribute VB_Exposed = False
  124. Option Explicit
  125. ' Reg Key Security Options...
  126. Const READ_CONTROL = &H20000
  127. Const KEY_QUERY_VALUE = &H1
  128. Const KEY_SET_VALUE = &H2
  129. Const KEY_CREATE_SUB_KEY = &H4
  130. Const KEY_ENUMERATE_SUB_KEYS = &H8
  131. Const KEY_NOTIFY = &H10
  132. Const KEY_CREATE_LINK = &H20
  133. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  134.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  135.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  136.                      
  137. ' Reg Key ROOT Types...
  138. Const HKEY_LOCAL_MACHINE = &H80000002
  139. Const ERROR_SUCCESS = 0
  140. Const REG_SZ = 1                         ' Unicode nul terminated string
  141. Const REG_DWORD = 4                      ' 32-bit number
  142. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  143. Const gREGVALSYSINFOLOC = "MSINFO"
  144. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  145. Const gREGVALSYSINFO = "PATH"
  146. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  147. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  148. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  149. Private Sub cmdSysInfo_Click()
  150.   Call StartSysInfo
  151. End Sub
  152. Private Sub cmdOK_Click()
  153.   Unload Me
  154. End Sub
  155. Private Sub Form_Load()
  156.     frmMain.Deck1.ChangeCard = 11
  157.     picIcon.Picture = frmMain.Deck1.Picture
  158.     Me.Caption = "About " & App.Title
  159.     lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
  160.     lblTitle.Caption = App.Title
  161. End Sub
  162. Public Sub StartSysInfo()
  163.     On Error GoTo SysInfoErr
  164.     Dim rc As Long
  165.     Dim SysInfoPath As String
  166.     ' Try To Get System Info Program Path\Name From Registry...
  167.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  168.     ' Try To Get System Info Program Path Only From Registry...
  169.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  170.         ' Validate Existance Of Known 32 Bit File Version
  171.         If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  172.             SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  173.             
  174.         ' Error - File Can Not Be Found...
  175.         Else
  176.             GoTo SysInfoErr
  177.         End If
  178.     ' Error - Registry Entry Can Not Be Found...
  179.     Else
  180.         GoTo SysInfoErr
  181.     End If
  182.     Call Shell(SysInfoPath, vbNormalFocus)
  183.     Exit Sub
  184. SysInfoErr:
  185.     MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  186. End Sub
  187. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  188.     Dim i As Long                                           ' Loop Counter
  189.     Dim rc As Long                                          ' Return Code
  190.     Dim hKey As Long                                        ' Handle To An Open Registry Key
  191.     Dim hDepth As Long                                      '
  192.     Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  193.     Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  194.     Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  195.     '------------------------------------------------------------
  196.     ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  197.     '------------------------------------------------------------
  198.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  199.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  200.     tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  201.     KeyValSize = 1024                                       ' Mark Variable Size
  202.     '------------------------------------------------------------
  203.     ' Retrieve Registry Key Value...
  204.     '------------------------------------------------------------
  205.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  206.                          KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  207.                         
  208.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  209.     If (Asc(Mid(tmpVal,